home *** CD-ROM | disk | FTP | other *** search
/ Windows News 1997 February / Windows News CD #1 - Fev 97.iso / share / prune51 / prune51.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-22  |  13.5 KB  |  486 lines
  1. {****************************************************************************
  2.   PRUNE 5.1 - by Cheul Chung, 1995
  3.   Copyright(c) 1994, 95, 96 by Cheul Chung
  4.  
  5.   This program recursively searches through a given directory tree and
  6.   deletes all files or those that fit the filename specified by the user.
  7.   Standard DOS wildcards (* and ?) can be entered. The program will not
  8.   delete hidden, read-only or system files, unless specified through
  9.   switches /H or /K. 
  10.  
  11.   Functions: DosErrorMsg, UpCaseStr, FName, FExt, CompareStr, IsDirEmpty
  12.   Procedures: processCommandLine, HandleDosError, DeleteFiles, RemoveDirs
  13.  
  14. ***************************************************************************}
  15. program PRUNE;
  16.  
  17. uses Dos;
  18.  
  19. const
  20.   LowerCase = ['a'..'z'];
  21.   UpperCase = ['A'..'Z'];
  22.   Numbers = [0..9];
  23. var
  24.   Level:      byte;       { Directory level to be searched }
  25.   Path:       pathStr;    { Full file path string }
  26.   Disk:       dirStr;     { Root disk or directory name }
  27.   Name:       nameStr;    { File name string }
  28.   Ext:        extStr;     { File extension string }
  29.   NumDirs:    integer;    { Total number of directories searched }
  30.   NumFiles:   integer;    { Number of files deleted }
  31.   DirsRemoved:integer;    { Number of directories removed }
  32.   Response:   string;     { User response }
  33.   Switch:     string;     { User options switch }
  34.   Str1, Str2: string;     { Misc. use }
  35.   massDeleteWarningOff,   { deletion warning off indicator }
  36.   deleteHRS,              { delete-all-file-types indicator }
  37.   PromptUser,             { prompt user before deletion? }
  38.   massDelete: boolean;    { mass delete option indicator }
  39.  
  40. function DosErrorMsg(ErrorCode: integer): string;
  41. begin
  42.   case ErrorCode of
  43.     1: DosErrorMsg:='Invalid Function Number.';
  44.     2: DosErrorMsg:='File not found.';
  45.     3: DosErrorMsg:='Path not found.';
  46.     4: DosErrorMsg:='Too many open files.';
  47.     5: DosErrorMsg:='Access denied.';
  48.     6: DosErrorMsg:='Invalid handle.';
  49.     7: DosErrorMsg:='Memory control blocks destroyed.';
  50.     8: DosErrorMsg:='Insufficient memory.';
  51.     9: DosErrorMsg:='Invalid memory block address.';
  52.     10: DosErrorMsg:='Invalid enviroment.';
  53.     11: DosErrorMsg:='Invalid format.';
  54.     12: DosErrorMsg:='Invalid access code.';
  55.     13: DosErrorMsg:='Invalid data.';
  56.     15: DosErrorMsg:='Invalid drive specified.';
  57.     16: DosErrorMsg:='Attempted to remove current directory.';
  58.     17: DosErrorMsg:='Not same device.';
  59.     18: DosErrorMsg:='No more files.';
  60.     152: DosErrorMsg:='Disk-read error.';
  61.     else DosErrorMsg:='Unknown Error.';
  62.   end;
  63. end;
  64.  
  65. procedure HandleDosError(DosErrorCode: integer);
  66.  
  67. begin
  68.   if (DosErrorCode<>0) and (DosErrorCode<>18) then
  69.   begin
  70.     write('DOS Error: ');
  71.     writeln(DosErrorMsg(DosErrorCode));
  72.     halt(1);
  73.   end;
  74. end;
  75.  
  76. function UpCaseStr(Str: string): string;
  77. {
  78. Upcases all lowercase characters in the string Str
  79. }
  80. var NewStr: string;
  81.     i: byte;
  82. begin
  83.   if Str='' then UpCaseStr:=''
  84.   else begin
  85.     Str:=Str+Chr(254);
  86.     NewStr:='';
  87.     i:=1;
  88.     repeat
  89.       if (Str[i] in LowerCase) then Str[i]:=UpCase(Str[i]);
  90.       NewStr:=NewStr+Str[i];
  91.       i:=i+1;
  92.     until Str[i]=Chr(254);
  93.     UpCaseStr:=NewStr;
  94.   end;
  95. end;
  96.  
  97. function FName(Str: string): string;
  98. {
  99. Separates the file name from the full file name string
  100. }
  101. var i: byte;
  102.     FN: string;
  103. begin
  104.   FN:='';
  105.   i:=1;
  106.   while (Str[i]<>'.') and (i<=Length(Str)) do
  107.     begin
  108.       FN:=FN+Str[i];
  109.       i:=i+1;
  110.     end;
  111.   if Length(FN)<8 then
  112.     for i:=Length(FN)+1 to 8 do FN:=FN+' ';   { Padding to make length=8 }
  113.   FName:=FN;
  114. end;
  115.  
  116. function FExt(Str: string): string;
  117. {
  118. Separates the file extension from a full file name and pads it with ' '
  119. to make length=3
  120. }
  121. var i: byte;
  122.     ExtLength: byte;
  123.     Ext: string;
  124. begin
  125.   Str:=Str+Chr(254);
  126.   Ext:='';
  127.   i:=1;
  128.   ExtLength:=0;
  129.   while (Str[i]<>'.') and (Str[i]<>Chr(254)) do i:=i+1;
  130.   if Str[i]=Chr(254) then Ext:='   '
  131.   else begin
  132.     i:=i+1;
  133.     repeat
  134.       Ext:=Ext+Str[i];
  135.       i:=i+1;
  136.       ExtLength:=ExtLength+1;
  137.     until Str[i]=Chr(254);
  138.     For ExtLength:=ExtLength to 2 do Ext:=Ext+' ';
  139.   end;
  140.   FExt:=Ext;
  141. end;
  142.  
  143. function CompareStr(FSearchStr, FStr: string): boolean;
  144. {
  145. compares file-spec to filename and returns true if they match
  146. }
  147. label Last;
  148.  
  149. var i: integer;
  150.     CharMatch: boolean;
  151.  
  152. begin
  153.   CharMatch:=TRUE;
  154.   i:=1;
  155.   while (CharMatch = TRUE) and (i <= Length(FSearchStr)) do begin
  156.     if FSearchStr[i] = '?' then CharMatch := TRUE
  157.     else if FSearchStr[i] = '*' then begin
  158.       CharMatch:=TRUE;
  159.       goto Last;
  160.     end
  161.     else if FSearchStr[i] = FStr[i] then CharMatch := TRUE
  162.     else CharMatch := false;
  163.     i:=i+1;
  164.   end;
  165.   if Length(FSearchStr) <> Length(FStr) then CharMatch:=false;
  166.   Last: CompareStr:=CharMatch;
  167. end;
  168.  
  169. procedure DeleteFiles(path: string);
  170. {
  171. main recursive process for deleting files
  172. }
  173. var
  174.   RightName, RightExt, RightFile: boolean;
  175.   NewPath: string;
  176.   fileinfo: SearchRec;
  177.   DelFile: file of byte;
  178.   i: byte;
  179. begin
  180.   Level:=Level+1;
  181.   findfirst( path+'\*.*', anyfile, fileinfo);
  182.   handleDosError(DosError);
  183.  
  184.   while DosError=0 do
  185.     begin
  186.       if (fileinfo.attr = directory) and  { Sub-directory }
  187.          (fileinfo.name[1] <> '.') then
  188.       begin
  189.         NewPath:=path+'\'+fileinfo.name;
  190.         NumDirs:=NumDirs+1;
  191.         DeleteFiles(NewPath);
  192.       end
  193.       else                              { NOT Sub-directory }
  194.       if (fileinfo.name[1] <> '.') and
  195.          ((fileinfo.attr and volumeID) <> volumeID) then
  196.         if (not deleteHRS) then begin
  197.           if ((fileinfo.attr and $01)<>$01) and
  198.              ((fileinfo.attr and $02)<>$02) and
  199.              ((fileinfo.attr and $04)<>$04) then
  200.           begin
  201.             if (massDelete) then
  202.               RightFile := TRUE
  203.             else begin
  204.               RightName := CompareStr(FName(Name),FName(fileinfo.name));
  205.               RightExt := CompareStr(FExt(Ext),FExt(fileinfo.name));
  206.               RightFile := (RightName) and (RightExt);
  207.             end;
  208.           end;
  209.         end
  210.         else begin
  211.           if (massDelete) then
  212.             RightFile := TRUE
  213.           else begin
  214.             RightName := CompareStr(FName(Name),FName(fileinfo.name));
  215.             RightExt := CompareStr(FExt(Ext),FExt(fileinfo.name));
  216.             RightFile := (RightName) and (RightExt);
  217.           end;
  218.         end;
  219.  
  220.       if RightFile=TRUE then
  221.       begin
  222.         Assign(DelFile,path+'\'+fileinfo.name);
  223.         SetFAttr(DelFile, Archive);
  224.         { Erase file if user confirms }
  225.         if PromptUser = TRUE then
  226.         begin
  227.           write('Delete ',path+'\'+fileinfo.name,' (y/n)?');
  228.           readln(response);
  229.           if UpCaseStr(response) = 'Y' then
  230.           begin
  231.             Erase(DelFile);
  232.             if DosError=0 then
  233.               NumFiles:=NumFiles+1
  234.             else
  235.               handleDosError(DosError);
  236.           end;
  237.         end
  238.         else
  239.         begin
  240.           Erase(DelFile);
  241.           if DosError=0 then
  242.             NumFiles:=NumFiles+1
  243.           else
  244.             handleDosError(DosError);
  245.         end;
  246.         RightFile:=False;
  247.       end;
  248.  
  249.       FindNext(fileinfo);
  250.       handleDosError(DosError);
  251.  
  252.     end;{ while }
  253.   Level:=Level-1;
  254. end;
  255.  
  256. function IsDirEmpty(PathStr: string): boolean;
  257. {
  258. returns TRUE if directory is empty, False otherwise.
  259. }
  260. var
  261.   FileInfo: searchrec;
  262.   FileNum: integer;
  263. begin
  264.   FileNum:=0;
  265.   findfirst(PathStr+'\*.*', AnyFile, FileInfo);
  266.   while (DosError=0) and (FileNum<3) do begin
  267.     if ((FileInfo.name<>'.') and (FileInfo.name<>'..'))
  268.        then FileNum:=FileNum+1;
  269.     findnext(FileInfo);
  270.   end;{while}
  271.   if FileNum=0 then IsDirEmpty:=TRUE
  272.      else IsDirEmpty:=False;
  273. end;
  274.  
  275. procedure RemoveDirs(path: string);
  276. var
  277.   NewPath: string;
  278.   FileInfo: searchrec;
  279. begin
  280.   Level:=Level+1;
  281.   if IsDirEmpty(path)=false then  { If dir is not empty, look for sub-dirs }
  282.     begin
  283.       findfirst(path+'\*.*', anyfile, FileInfo);
  284.       while DosError=0 do
  285.         begin
  286.           if ((FileInfo.attr=directory) and (FileInfo.name[1]<>'.')) then
  287.              begin
  288.                NewPath:=path+'\'+FileInfo.name;
  289.                RemoveDirs(NewPath);
  290.              end;
  291.           FindNext(FileInfo);
  292.         end;{while}
  293.     end;{if}
  294.   if IsDirEmpty(path)=TRUE then  { If directory is empty, remove it }
  295.     begin
  296.       RmDir(path);
  297.       if (DosError<>0) and (DosError<>18)
  298.          then writeln(DosErrorMsg(DosError))
  299.       else DirsRemoved:=DirsRemoved+1;
  300.     end;{if}
  301.   Level:=Level-1;
  302. end;
  303.  
  304. procedure displayInfo;
  305. {
  306. display usage and product information
  307. }
  308. begin
  309.   writeln('PRUNE - Selective File Deleter - V5.1 - Copyright(C) 1994-96 by Cheul Chung');
  310.   writeln;
  311.   writeln('PRUNE searches through a given directory and its sub-directories and');
  312.   writeln('  deletes all files matching the filename specified by the user. Standard');
  313.   writeln('  wildcards (* and ?) may be entered. The program will not delete hidden,');
  314.   writeln('  read-only, or system files, unless specified through switches /H or /K.');
  315.   writeln;
  316.   writeln('Usage: PRUNE [disk:][\directory\...\]<filename> [/H][/P][/D][/K][/XD][/XK]');
  317.   writeln;
  318.   writeln('Possible Options: /H, /P, /D, /K, /XD, /XK');
  319.   writeln;
  320.   writeln(' H - delete hidden, read-only and system files');
  321.   writeln(' P - turn off prompting on individual files');
  322.   writeln(' D - mass delete: delete all files and remove all directories (except');
  323.   writeln('       hidden, read-only, and system files)');
  324.   writeln(' K - mass kill: delete all files and remove all directories (including');
  325.   writeln('       hidden, read-only, and system files *USE WITH CARE*)');
  326.   writeln(' X - turn off mass deletion warning');
  327.   writeln;
  328.   writeln('PRUNE 5.1 is freeware and may be freely distributed and used for non-commercial');
  329.   writeln('purposes. For information on commercial use of PRUNE 5.1, please refer to the');
  330.   writeln('accompanying documentation.');
  331. end;
  332.  
  333. procedure processCommandLine(var path: pathStr;
  334.                              var disk: dirStr;
  335.                              var name: nameStr;
  336.                              var ext: extStr;
  337.                              var switch: string);
  338. {
  339. read in and process command line arguments, separating them into components
  340. }
  341. var TestFileName : pathStr;
  342.     TestFile : file;
  343.     FAttrib : word;
  344. begin
  345.   if ParamCount = 0 then begin
  346.     displayInfo;
  347.     halt(1);
  348.   end
  349.   else
  350.   if ParamCount >= 1 then begin
  351.     Str1 := ParamStr(1);
  352.     If Str1[1]='/' then begin
  353.       displayInfo;
  354.       halt(1);
  355.     end
  356.     else begin
  357.       Path:=ParamStr(1);
  358.       Switch:=UpCaseStr(ParamStr(2));
  359.     end;
  360.   end;
  361.   {
  362.     expand and split path
  363.   }
  364.   Path:=FExpand(Path);
  365.   FSplit(Path,Disk,Name,Ext);
  366.   {
  367.     check if filename given is a directory
  368.     if it is, change filename to diskname
  369.   }
  370.   TestFileName:=Path;
  371.   assign(TestFile, TestFileName);
  372.   GetFAttr(TestFile, FAttrib);
  373.   if (FAttrib and Directory) = Directory then begin
  374.     Disk:=Disk+Name+Ext;
  375.     Name:='';
  376.     Ext:='';
  377.   end;
  378.   {
  379.     if no diskname was given, set diskname to current directory
  380.   }
  381.   if Disk='' then GetDir(0, Disk);
  382.   {
  383.     delete any trailing backslashes
  384.   }
  385.   if Disk[length(Disk)]='\' then delete(Disk,length(Disk),1);
  386. end;{ processCommandLine }
  387.  
  388. begin {*** MAIN ***}
  389.   {
  390.     intialize variables
  391.   }
  392.   Level:=0;
  393.   NumDirs:=0;
  394.   NumFiles:=0;
  395.   Disk:='';
  396.   Name:='';
  397.   Ext:='';
  398.   switch:='';
  399.   massDeleteWarningOff := FALSE;
  400.   deleteHRS := FALSE;
  401.   massDelete := FALSE;
  402.   PromptUser := TRUE;
  403.  
  404.   processCommandLine(path, disk, name, ext, switch);
  405.  
  406.   switch := upcaseStr(switch);
  407.  
  408.   if switch = '/?' then
  409.   begin
  410.     displayInfo;
  411.     halt(1);
  412.   end
  413.   else if switch = '/P' then PromptUser := FALSE
  414.   else if switch = '/H' then deleteHRS := TRUE
  415.   else if switch = '/D' then begin { mass delete }
  416.     massDelete := TRUE;
  417.     PromptUser := FALSE;
  418.   end
  419.   else if switch = '/K' then begin { mass kill }
  420.     massDelete := TRUE;
  421.     deleteHRS := TRUE;
  422.     PromptUser := FALSE;
  423.   end
  424.   else if (switch = '/XD') or
  425.           (switch = '/DX') then  { mass delete w/o warning }
  426.   begin
  427.     massDelete := TRUE;
  428.     massDeleteWarningOff := TRUE;
  429.     promptUser := FALSE;
  430.   end
  431.   else if (switch = '/XK') or
  432.           (switch = '/KX') then  { mass kill w/o warning }
  433.   begin
  434.     deleteHRS := TRUE;
  435.     massDelete := TRUE;
  436.     massDeleteWarningOff := TRUE;
  437.     promptUser := FALSE;
  438.   end;
  439.  
  440.   if (massDelete) then
  441.   begin
  442.     if (massDeleteWarningOff) then
  443.     begin
  444.       DeleteFiles(Disk);
  445.       writeln('   ',NumFiles,' file(s) deleted.');
  446.       if (massDelete) then
  447.       begin
  448.         removeDirs(Disk);
  449.         writeln('   ',DirsRemoved,' directories removed.');
  450.       end;
  451.     end
  452.     else
  453.     begin
  454.       writeln;
  455.       writeln('WARNING: You have chosen the mass delete option.');
  456.       writeln('         All files in the directory tree of ',Disk);
  457.       writeln('         will be deleted and all sub-directories removed.');
  458.       writeln;
  459.       write('Proceed with mass delete? (Y/N)');
  460.       readln(response);
  461.       if response='y' then
  462.       begin
  463.         DeleteFiles(Disk);
  464.         writeln;
  465.         writeln('   ',NumFiles,' file(s) deleted.');
  466.         removeDirs(Disk);
  467.         writeln('   ',DirsRemoved,' directories removed.');
  468.       end
  469.       else
  470.       begin
  471.         writeln;
  472.         writeln('Prune aborted.');
  473.       end;
  474.     end;
  475.   end
  476.   else
  477.   begin
  478.     deleteFiles(Disk);
  479.     writeln;
  480.     writeln('   ',NumFiles,' file(s) deleted.');
  481.   end;{ if }
  482.  
  483. end.
  484.  
  485.  
  486.